unit CPParserBase;

interface

uses SysUtils, Contnrs;

type
  { Base type of numeric values in all parser-related classes }
  TCPFloat = Double;
  PCPFloat = ^TCPFloat;

  { Array of numeric values }
  TCPFloatArray = array [0 .. $FFFFFFFF div (SizeOf(TCPFloat) * 2) - 1]
    of TCPFloat;
  PCPFloatArray = ^TCPFloatArray;

  { Array used as evaluation stack }
  TCPEvaluationStack = array of TCPFloat;

  { Pointer to function that returns a number }
  TCPEvaluateFunction = function: TCPFloat of object;

  { Describes the semantic operation of common mathematical operators }
  TCPOperation = (opPower, opMultiply, opDivide, opModulo, opAdd, opSubtract,
    opNegativeSign, opPositiveSign);

  { Definition of an operator }
  TCPOperator = record
    Name: string;
    { Semantic description of operator }
    Operation: TCPOperation;
    { True, if the operator is left-associative; otherwise, false }
    LeftAssociative: Boolean;
    { Operator predeence, higher values express higher precdedence }
    Precedence: Integer;
    { Number of required operands, unary operators have an arity of 1,
      binary operators have an arity of 2 }
    Arity: Integer;
  end;

  PCPOperator = ^TCPOperator;

var
  CPFormatSettings: TFormatSettings;

const
  { Variable name that serves as function argument as default }
  CPDefaultArgumentVariable = 'x';

  { Initial stack size as number of elements }
  CPDefaultStackCount = 128;

  { Character symbol for positive sign }
  CPSignPositive = '+';
  { Character symbol for negative sign }
  CPSignNegative = '-';

  CPPower1 = '^';
  CPPower2 = '**';
  CPMultiply = '*';
  CPDivide = '/';
  CPModulo = '%';
  CPAdd = '+';
  CPSubtract = '-';

  { Character symbol for left parenthesis }
  CPLeftParen = '(';

  { Character symbol for right parenthesis }
  CPRightParen = ')';

  { Character symbol for function argument separator }
  CPArgSeparator = ',';

  { Maps a sign as Boolean to its character symbol.
    False represents a negative sign and True represents a positive sign. }
  CPSignStrings: array [False .. True] of string =
    (CPSignNegative, CPSignPositive);

  { Value of Pi constant }
  CPPi = 3.1415926535897932384626433832795028841971693993751058209749445923;
  { Value of Euler's number e }
  CPE = 2.7182818284590452353602874713526624977572470936999595749669676277;

  CPOperatorPower: TCPOperator = (Name: CPPower1; Operation: opPower;
    LeftAssociative: False; Precedence: 3; Arity: 2);
  CPOperatorMultiply: TCPOperator = (Name: CPMultiply; Operation: opMultiply;
    LeftAssociative: True; Precedence: 2; Arity: 2);
  CPOperatorDivide: TCPOperator = (Name: CPDivide; Operation: opDivide;
    LeftAssociative: True; Precedence: 2; Arity: 2);
  CPOperatorModulo: TCPOperator = (Name: CPModulo; Operation: opModulo;
    LeftAssociative: True; Precedence: 2; Arity: 2);
  CPOperatorAdd: TCPOperator = (Name: CPAdd; Operation: opAdd;
    LeftAssociative: True; Precedence: 1; Arity: 2);
  CPOperatorSubtract: TCPOperator = (Name: CPSubtract; Operation: opSubtract;
    LeftAssociative: True; Precedence: 1; Arity: 2);
  CPOperatorSignNegative: TCPOperator = (Name: CPSignNegative;
    Operation: opNegativeSign; LeftAssociative: False; Precedence: 2; Arity: 1);
  CPOperatorSignPositive: TCPOperator = (Name: CPSignPositive;
    Operation: opPositiveSign; LeftAssociative: False; Precedence: 2; Arity: 1);

  { Contains all available operator tokens and maps them to operators
    @seealso CPOperatorTokenValues }
  CPOperatorTokenKeys: array [0 .. 8] of string =
    (CPPower2, CPPower1, CPMultiply, CPDivide, CPModulo, CPAdd, CPSubtract,
    CPSignNegative, CPSignPositive);

  { Maps operators to all available operator tokens
    @seealso CPOperatorTokenKeys }
  CPOperatorTokenValues: array [0 .. 8] of PCPOperator =
    (@CPOperatorPower, @CPOperatorPower, @CPOperatorMultiply,
    @CPOperatorDivide, @CPOperatorModulo, @CPOperatorAdd, @CPOperatorSubtract,
    @CPOperatorSignNegative, @CPOperatorSignPositive);

  { Contains all available operators, operators with longest names come first }
  CPOperators: array [TCPOperation] of PCPOperator =
    (@CPOperatorPower, @CPOperatorMultiply, @CPOperatorDivide,
    @CPOperatorModulo, @CPOperatorAdd, @CPOperatorSubtract,
    @CPOperatorSignNegative, @CPOperatorSignPositive);

type
  { Exception that is thrown when a hash key is not found in TCPStringHashMap
    @seealso TCPStringHashMap }
  ECPKeyNotFoundException = class(Exception);

  { Error that is thrown, if a wrong text sequence is formed }
  ECPInvalidTextSequence = class(Exception)
  end;

  { Describes a consecutive sequence of characters inside a text string.
    The sequence starts at a certain postion of the text string and spans
    over a certain length of characters. The character length of the sequence
    is identified by FStop, which contains the position of the last character
    + 1. }
  TCPTextSequence = class
  private
    FText: string;
    FStart: Integer;
    FStop: Integer;
    function GetLength: Integer;
    procedure SetLength(const Value: Integer);
    procedure SetStart(const Value: Integer);
    procedure SetStop(const Value: Integer);
    procedure RaiseInvalidSequenceError(NewStart, NewStop: Integer);
    function GetCharacter(Index: Integer): Char;
  public
    { Creates a new text sequence.
      @param Text Text string that is referred to
      @param Start Index of first sequence character
      @param Stop Index after last sequence character }
    constructor Create(Text: string; Start: Integer; Stop: Integer); overload;
    { Creates a new text sequence ranging over the complete string
      @param Text Text string that is referred to }
    constructor Create(Text: string); overload;
    { Creates a new text sequence containing one character identified by
      the character index Position
      @param Position Index of the character identified by this sequence }
    constructor Create(Text: string; Position: Integer); overload;
    { Creates a copy of the specified text sequence }
    constructor Create(Sequence: TCPTextSequence); overload;
    { Returns the text sequence as a string }
    function ToString: string;
{$IF CompilerVersion < 20} virtual; {$ELSE} override; {$IFEND}
    { Text string that is refered to by this text sequence }
    property Text: string read FText;
    { Sequence starts at this character index of the text string }
    property Start: Integer read FStart write SetStart;
    { Sequence ends one character before this character index of the text
      string. So Text[Stop - 1] is the last character of the sequence. }
    property Stop: Integer read FStop write SetStop;
    { Number of characters of this text sequence. Changing this length
      moves the Stop index of this sequence. }
    property Length: Integer read GetLength write SetLength;
    { Gets an indexed character of the sequence }
    property Characters[Index: Integer]: Char read GetCharacter; default;
  end;

  { Types of different errors that can occur in expressions }
  TCPErrorCode = (
    // Tokenizer errors:
    ecUnexpectedToken = 1, ecInvalidNumber, ecInvalidSignificand,
    ecInvalidCharacter,
    // Parser errors:
    ecInvalidRightParen, ecRightParenExpected, ecInvalidArgSeparator,
    ecUnknownFunction, ecInvalidVariableName, ecInvalidArgumentCount,
    // Other errors:
    ecCircularReference);

  { Class that represents an error }
  TCPExpressionError = class(Exception)
  private
    FErrorCode: TCPErrorCode;
    FSequence: TCPTextSequence;
    FErrorMessage: string;
    function GetErrorMessage(Description: string): string;
  public
    { Creates a new instance by making a copy of the specified instance
      @param Error Error instance that is copied. }
    constructor Create(Error: TCPExpressionError); overload;
    { Creates a new instance
      @param ErrorCode Error code identifying this kind of error
      @param Sequence Text sequence that is causing the error
      @param Description Additional information that is inserted into
        the error messages of some error codes. }
    constructor Create(ErrorCode: TCPErrorCode; Sequence: TCPTextSequence;
      Description: string); overload;
    destructor Destroy; override;
    property ErrorCode: TCPErrorCode read FErrorCode;
    property Sequence: TCPTextSequence read FSequence;
    property ErrorMessage: string read FErrorMessage;
  end;

  { Base class type for parser and tokenizer exceptions }
  ECPInvalidExpressionException = class(TCPExpressionError);

const
  CPNumberRange = '%d-%d';
  CPErrorMessages : array[TCPErrorCode] of string =
  (
    'Input not allowed at this position, expected one of the the following elements: %s',
    'Invalid number',
    'Invalid scientific notation',
    'Invalid character',
    'Invalid closing brace',
    'Missing closing brace',
    'Invalid argument separator',
    'Unknown function name',
    'Invalid variable name',
    'Incorrect number of function arguments (expected %s argument(s))',
    'Variable cannot be evaluated, because it is part of the circular reference %s'
  );

{ Returns the specified interval as short localized string
  @param LowerBound Lower bound of interval
  @param UpperBound Upper bound of interval
  @return Text representation of interval }
function CPGetRangeString(LowerBound, UpperBound: Integer): string;


implementation

uses Math, gnugettext;

function CPGetRangeString(LowerBound, UpperBound: Integer): string;
begin
  if (LowerBound = UpperBound) then
    Result := IntToStr(LowerBound)
  else
    Result := Format(CPNumberRange, [LowerBound, UpperBound]);
end;

{ TCPTextSequence }

constructor TCPTextSequence.Create(Text: string; Start, Stop: Integer);
begin
  FText := Text;
  FStart := Start;
  FStop := Stop;
end;

constructor TCPTextSequence.Create(Text: string);
begin
  Create(Text, 1, System.Length(Text) + 1);
end;

constructor TCPTextSequence.Create(Text: string; Position: Integer);
begin
  Create(Text, Position, Position + 1);
end;

constructor TCPTextSequence.Create(Sequence: TCPTextSequence);
begin
  Create(Sequence.FText, Sequence.FStart, Sequence.FStop);
end;

function TCPTextSequence.GetCharacter(Index: Integer): Char;
begin
  Result := FText[Index];
end;

function TCPTextSequence.GetLength: Integer;
begin
  Result := FStop - FStart;
end;

procedure TCPTextSequence.RaiseInvalidSequenceError(NewStart, NewStop: Integer);
begin
  raise ECPInvalidTextSequence.CreateFmt(
    'Sequence interval is invalid (Start: %d, Stop: %d)', [NewStart, NewStop]);
end;

procedure TCPTextSequence.SetLength(const Value: Integer);
begin
  if Value >= 0 then
    FStop := FStart + Value;
end;

procedure TCPTextSequence.SetStart(const Value: Integer);
begin
  if (Value > 0) and (Value <= FStop) then
    FStart := Value
  else
    RaiseInvalidSequenceError(Value, FStop);
end;

procedure TCPTextSequence.SetStop(const Value: Integer);
begin
  if (Value >= FStart) and (Value <= System.Length(FText) + 1) then
    FStop := Value
  else
    RaiseInvalidSequenceError(FStart, Value);
end;

function TCPTextSequence.ToString: string;
begin
  Result := Copy(FText, FStart, FStop - FStart);
end;

{ TCPExpressionError }

constructor TCPExpressionError.Create(ErrorCode: TCPErrorCode;
  Sequence: TCPTextSequence; Description: string);
begin
  FErrorCode := ErrorCode;
  FSequence := Sequence;
  FErrorMessage := GetErrorMessage(Description);
end;

constructor TCPExpressionError.Create(Error: TCPExpressionError);
begin
  FErrorCode := Error.ErrorCode;
  FSequence := TCPTextSequence.Create(Error.Sequence);
  FErrorMessage := Error.FErrorMessage;
end;

destructor TCPExpressionError.Destroy;
begin
  FSequence.Free;
  inherited;
end;

function TCPExpressionError.GetErrorMessage(Description: string): string;
var
  PositionString: string;
begin
  Result := Format(_(CPErrorMessages[ErrorCode]), [Description]);
  PositionString := '';
  if (Sequence.Start > 0) then
  begin
    // Space character in front of position string is needed:
    PositionString := Format(' ' + _('at position %d'), [Sequence.Start]);
    if Sequence.Stop > Sequence.Start then
      PositionString := PositionString + '-' + IntToStr(Sequence.Stop - 1);
  end;
  Result := Format('E%d%s: %s',
    [Ord(ErrorCode), PositionString, Result]);
end;

initialization

// Use format settings of english locale by default:
GetLocaleFormatSettings($0409, CPFormatSettings);

finalization

end.
